home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE21 / HTMLVIEW / HTMLVIEW.ZIP / DEMOSRC.ZIP / DEMOUNIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-10-14  |  10.1 KB  |  383 lines
  1. unit demounit;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, Menus, Htmlview, StdCtrls, FontDlg,
  8.   htmlabt, Submit, MMSystem;
  9.                                         
  10. const
  11.   MaxHistories = 6;  {size of History list}
  12. type
  13.   TForm1 = class(TForm)
  14.     OpenDialog: TOpenDialog;
  15.     MainMenu: TMainMenu;
  16.     Panel1: TPanel;
  17.     Panel2: TPanel;
  18.     Panel3: TPanel;
  19.     File1: TMenuItem;
  20.     Open: TMenuItem;
  21.     options1: TMenuItem;
  22.     ShowImages: TMenuItem;
  23.     Fonts: TMenuItem;
  24.     Edit1: TEdit;
  25.     Reload: TButton;
  26.     BackButton: TButton;
  27.     FwdButton: TButton;
  28.     HistoryMenuItem: TMenuItem;
  29.     Exit: TMenuItem;
  30.     N1: TMenuItem;
  31.     Print1: TMenuItem;
  32.     PrintDialog: TPrintDialog;
  33.     About1: TMenuItem;
  34.     Edit2: TMenuItem;
  35.     Find1: TMenuItem;
  36.     FindDialog: TFindDialog;
  37.     Viewer: THTMLViewer;
  38.     CopyItem: TMenuItem;
  39.     N2: TMenuItem;
  40.     SelectAllItem: TMenuItem;
  41.     procedure OpenFileClick(Sender: TObject);
  42.     procedure HotSpotChange(Sender: TObject; const URL: string);
  43.     procedure HotSpotClick(Sender: TObject; const URL: string;
  44.               var Handled: boolean);
  45.     procedure ShowImagesClick(Sender: TObject);
  46.     procedure ReloadClick(Sender: TObject);
  47.     procedure FormCreate(Sender: TObject);
  48.     procedure FwdBackClick(Sender: TObject);
  49.     procedure HistoryClick(Sender: TObject);
  50.     procedure HistoryChange(Sender: TObject);
  51.     procedure ExitClick(Sender: TObject);
  52.     procedure FontColorsClick(Sender: TObject);
  53.     procedure Print1Click(Sender: TObject);
  54.     procedure About1Click(Sender: TObject);
  55.     procedure FormShow(Sender: TObject);
  56.     procedure SubmitEvent(Sender: TObject; Action, Method: String;
  57.       Results: TStringList);
  58.     procedure Find1Click(Sender: TObject);
  59.     procedure FindDialogFind(Sender: TObject);
  60.     procedure ProcessingHandler(Sender: TObject; ProcessingOn: Boolean);
  61.     procedure CopyItemClick(Sender: TObject);
  62.     procedure Edit2Click(Sender: TObject);
  63.     procedure SelectAllItemClick(Sender: TObject);
  64.   private
  65.     { Private declarations }
  66.     Histories: array[0..MaxHistories-1] of TMenuItem;
  67.   public
  68.     { Public declarations }
  69.   end;
  70.  
  71. var
  72.   Form1: TForm1;
  73.  
  74. implementation
  75.  
  76. {$R *.DFM}
  77.  
  78. procedure TForm1.FormCreate(Sender: TObject);
  79. var
  80.   I: integer;
  81. begin
  82. if Screen.Width <= 640 then
  83.   Position := poDefault;  {keeps form on screen better}
  84.  
  85. OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  86.  
  87. ShowImages.Checked := Viewer.ViewImages;
  88. Viewer.HistoryMaxCount := MaxHistories;  {defines size of history list}
  89.  
  90. for I := 0 to MaxHistories-1 do
  91.   begin      {create the MenuItems for the history list}
  92.   Histories[I] := TMenuItem.Create(HistoryMenuItem);
  93.   HistoryMenuItem.Insert(I, Histories[I]);
  94.   with Histories[I] do
  95.     begin
  96.     Visible := False;
  97.     OnClick := HistoryClick;
  98.     Tag := I;
  99.     end;
  100.   end;
  101. end;
  102.  
  103. procedure TForm1.FormShow(Sender: TObject);
  104. begin
  105. if (ParamCount >= 1) then
  106.   Viewer.LoadFromFile(ParamStr(1));  {Parameter is file to load}
  107. end;
  108.  
  109. procedure TForm1.OpenFileClick(Sender: TObject);
  110. begin
  111. if Viewer.CurrentFile <> '' then
  112.   OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
  113. if OpenDialog.Execute then
  114.   begin
  115.   Viewer.LoadFromFile(OpenDialog.Filename);
  116.   Caption := Viewer.DocumentTitle;
  117.   end;
  118. end;
  119.  
  120. procedure TForm1.HotSpotChange(Sender: TObject; const URL: string);
  121. {mouse moved over or away from a hot spot.  Change the status line}
  122. begin
  123. Panel1.Caption := URL;
  124. end;
  125.  
  126. procedure TForm1.HotSpotClick(Sender: TObject; const URL: string;
  127.           var Handled: boolean);
  128. {This routine handles what happens when a hot spot is clicked.  The assumption
  129.  is made that DOS filenames are being used. .EXE, .WAV, .MID, and .AVI files are
  130.  handled here, but other file types could be easily added.
  131.  
  132.  If the URL is handled here, set Handled to True.  If not handled here, set it
  133.  to False and ThtmlViewer will handle it.}
  134. const
  135.   snd_Async = $0001;  { play asynchronously }
  136. var
  137.   PC: array[0..255] of char;
  138.   S, Params: string[255];
  139.   Ext: string[5];
  140.   I, J, K: integer;
  141.  
  142. begin
  143. Handled := False;
  144. I := Pos(':', URL);
  145. J := Pos('FILE:', UpperCase(URL));
  146. if (I <= 2) or (J > 0) then
  147.   begin                      {apparently the URL is a filename}
  148.   S := URL;
  149.   K := Pos(' ', S);     {look for parameters}
  150.   if K = 0 then K := Pos('?', S);  {could be '?x,y' , etc}
  151.   if K > 0 then
  152.     begin
  153.     Params := Copy(S, K+1, 255); {save any parameters}
  154.     S[0] := chr(K-1);            {truncate S}
  155.     end
  156.   else Params := '';
  157.   S := Viewer.HTMLExpandFileName(S);
  158.   Ext := Uppercase(ExtractFileExt(S));
  159.   if Ext = '.WAV' then
  160.     begin
  161.     Handled := True;
  162.     sndPlaySound(StrPCopy(PC, S), snd_ASync);
  163.     end
  164.   else if Ext = '.EXE' then
  165.     begin
  166.     Handled := True;
  167.     WinExec(StrPCopy(PC, S+' '+Params), sw_Show);
  168.     end
  169.   else if (Ext = '.MID') or (Ext = '.AVI')  then
  170.     begin
  171.     Handled := True;
  172.     WinExec(StrPCopy(PC, 'MPlayer.exe /play /close '+S), sw_Show);
  173.     end;
  174.   {else ignore other extensions}
  175.   Edit1.Text := URL;
  176.   end
  177. else Edit1.Text := URL;   {other protocall, mailto:, ftp:, etc.}
  178. end;
  179.  
  180. procedure TForm1.ShowImagesClick(Sender: TObject);
  181. {The Show Images menu item was clicked}
  182. begin
  183. With Viewer do
  184.   begin
  185.   ViewImages := not ViewImages;
  186.   (Sender as TMenuItem).Checked := ViewImages;
  187.   end;
  188. end;
  189.  
  190. procedure TForm1.ReloadClick(Sender: TObject);
  191. {the Reload button was clicked}
  192. var
  193.   Pos: LongInt;
  194. begin
  195. with Viewer do
  196.   begin
  197.   ReLoad.Enabled := False;
  198.   Pos := Position;     {save the postion}
  199.   LoadFromFile(CurrentFile);   {load again}
  200.   Position := Pos;     {restore position}
  201.   Reload.Enabled := CurrentFile <> '';
  202.   Viewer.SetFocus;
  203.   end;
  204. end;
  205.  
  206. procedure TForm1.FwdBackClick(Sender: TObject);
  207. {Either the Forward or Back button was clicked}
  208. begin
  209. with Viewer do
  210.   begin
  211.   if Sender = BackButton then
  212.     HistoryIndex := HistoryIndex +1
  213.   else
  214.     HistoryIndex := HistoryIndex -1;
  215.   end;
  216. end;
  217.  
  218. procedure TForm1.HistoryChange(Sender: TObject);
  219. {This event occurs when something changes history list}
  220. var
  221.   I: integer;
  222.   Cap: string[80];
  223. begin
  224. with Sender as ThtmlViewer do
  225.   begin
  226.   {check to see which buttons are to be enabled}
  227.   FwdButton.Enabled := HistoryIndex > 0;
  228.   BackButton.Enabled := HistoryIndex < History.Count-1;
  229.  
  230.   {Enable and caption the appropriate history menuitems}
  231.   HistoryMenuItem.Visible := History.Count > 0;
  232.   for I := 0 to MaxHistories-1 do
  233.     with Histories[I] do
  234.       if I < History.Count then
  235.         Begin
  236.         Cap := History.Strings[I];
  237.         if TitleHistory[I] <> '' then
  238.           Cap := Cap + '--' + TitleHistory[I];
  239.         Caption := Cap;    {Cap limits string to 80 char}
  240.         Visible := True;
  241.         Checked := I = HistoryIndex;
  242.         end
  243.       else Histories[I].Visible := False;
  244.   Caption := DocumentTitle;    {keep the caption updated}
  245.   Viewer.SetFocus;  
  246.   end;
  247. end;
  248.  
  249. procedure TForm1.HistoryClick(Sender: TObject);
  250. {A history list menuitem got clicked on}
  251. begin
  252.   {Changing the HistoryIndex loads and positions the appropriate document}
  253.   Viewer.HistoryIndex := (Sender as TMenuItem).Tag;
  254. end;
  255.  
  256. procedure TForm1.ExitClick(Sender: TObject);
  257. begin
  258. Close;
  259. end;
  260.  
  261. procedure TForm1.FontColorsClick(Sender: TObject);
  262. var
  263.   FontForm: TFontForm;
  264. begin
  265. FontForm := TFontForm.Create(Self);
  266. try
  267.   with FontForm do
  268.     begin
  269.     FontName := Viewer.DefFontName;
  270.     FontColor := Viewer.DefFontColor;
  271.     FontSize := Viewer.DefFontSize;
  272.     HotSpotColor := Viewer.DefHotSpotColor;
  273.     Background := Viewer.DefBackground;
  274.     if ShowModal = mrOK then
  275.       begin
  276.       Viewer.DefFontName := FontName;
  277.       Viewer.DefFontColor := FontColor;
  278.       Viewer.DefFontSize := FontSize;
  279.       Viewer.DefHotSpotColor := HotSpotColor;
  280.       Viewer.DefBackground := Background;
  281.       ReloadClick(Self);    {reload to see how it looks}
  282.       end;
  283.     end;
  284. finally
  285.   FontForm.Free;
  286.  end;
  287. end;
  288.  
  289. procedure TForm1.Print1Click(Sender: TObject);
  290. begin
  291. with PrintDialog do
  292.   if Execute then
  293.     if PrintRange = prAllPages then
  294.       viewer.Print(1, 9999)
  295.     else
  296.       Viewer.Print(FromPage, ToPage);
  297. end;
  298.  
  299. procedure TForm1.About1Click(Sender: TObject);
  300. begin
  301. AboutBox := TAboutBox.Create(Self);
  302. try
  303.   AboutBox.ShowModal;
  304. finally
  305.   AboutBox.Free;
  306.   end;
  307. end;
  308.  
  309.  
  310. procedure TForm1.SubmitEvent(Sender: TObject; Action, Method: String;
  311.   Results: TStringList);
  312. begin
  313. with SubmitForm do
  314.   begin
  315.   ActionText.Text := Action;
  316.   MethodText.Text := Method;
  317.   ResultBox.Items := Results;
  318.   Results.Free;
  319.   Show;
  320.   end;
  321. end;
  322.  
  323. procedure TForm1.Find1Click(Sender: TObject);
  324. begin
  325. FindDialog.Execute;
  326. end;
  327.  
  328. procedure TForm1.FindDialogFind(Sender: TObject);
  329. begin
  330. with FindDialog do
  331.   begin
  332.   if not Viewer.Find(FindText, frMatchCase in Options) then
  333.     MessageDlg('No further occurances of "'+FindText+'"', mtInformation, [mbOK], 0);
  334.   end;
  335. end;
  336.  
  337. procedure TForm1.ProcessingHandler(Sender: TObject; ProcessingOn: Boolean);
  338. begin
  339. if ProcessingOn then
  340.   begin    {disable various buttons and menuitems during processing}
  341.   FwdButton.Enabled := False;
  342.   BackButton.Enabled := False;
  343.   Reload.Enabled := False;
  344.   Print1.Enabled := False;
  345.   Find1.Enabled := False;
  346.   SelectAllItem.Enabled := False;
  347.   Open.Enabled := False;
  348.   end
  349. else
  350.   begin
  351.   FwdButton.Enabled := Viewer.HistoryIndex > 0;
  352.   BackButton.Enabled := Viewer.HistoryIndex < Viewer.History.Count-1;
  353.   ReLoad.Enabled := Viewer.CurrentFile <> '';
  354.   Print1.Enabled := Viewer.CurrentFile <> '';
  355.   Find1.Enabled := Viewer.CurrentFile <> '';
  356.   SelectAllItem.Enabled := Viewer.CurrentFile <> '';
  357.   Open.Enabled := True;
  358.   end;
  359. end;
  360.  
  361. procedure TForm1.CopyItemClick(Sender: TObject);
  362. var
  363.   Rslt: word;
  364. begin
  365. Rslt := mrOK;
  366. if Viewer.SelLength > 32000 then
  367.   Rslt := MessageDlg('Selection exceeds buffer size and may be truncated',
  368.     mtWarning, [mbOK, mbCancel], 0);
  369. if Rslt = mrOK then Viewer.CopyToClipboard;
  370. end;
  371.  
  372. procedure TForm1.Edit2Click(Sender: TObject);
  373. begin
  374. CopyItem.Enabled := Viewer.SelLength > 0; 
  375. end;
  376.  
  377. procedure TForm1.SelectAllItemClick(Sender: TObject);
  378. begin
  379. Viewer.SelectAll;
  380. end;
  381.  
  382. end.
  383.